home *** CD-ROM | disk | FTP | other *** search
/ The Programmer Disk / The Programmer Disk (Microforum).iso / xpro / qb2 / pro15 / wormy.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1990-08-20  |  2.3 KB  |  121 lines
  1. {
  2.  ******************************************************************************
  3.  * WORMY - Circle drawing demo.                              *
  4.  *                                          *
  5.  * Written for GRAFIX by:  Joseph A. Albrecht                      *
  6.  *                                          *
  7.  * Press F10 to toggle between 320 and 640 graphic modes              *
  8.  * Press ESC to exit program                              *
  9.  ******************************************************************************
  10. }
  11.  
  12. PROGRAM Wormy;
  13.  
  14. USES
  15.   Crt,
  16.   Dos,
  17.   Grafix;
  18.  
  19. VAR
  20.   Graphics, X, Y, C, Radius: INTEGER;
  21.   H, M, S, S100: WORD;
  22.   XR, YR, CR: REAL;
  23.   Loop, Tandy11: BOOLEAN;
  24.  
  25. PROCEDURE CheckKey;
  26.  
  27. VAR
  28.   Ch: CHAR;
  29.  
  30. BEGIN
  31.  
  32.   Ch := #255;
  33.   IF KeyPressed THEN
  34.     Ch := ReadKey;
  35.   IF Ch = #27 THEN
  36.      BEGIN
  37.        ExitGraphics;
  38.        Halt(0);
  39.      END;
  40.   IF Ch = #00 THEN
  41.     BEGIN
  42.       Ch := ReadKey;
  43.       IF (Ch = #68) AND (Tandy11 = True) THEN
  44.     BEGIN
  45.       IF Graphics = 320 THEN
  46.         BEGIN
  47.           Graphics := 640;
  48.           Loop := False;
  49.           HighGraphics;
  50.         END
  51.       ELSE
  52.          BEGIN
  53.            Graphics := 320;
  54.            Loop := False;
  55.            MediumGraphics;
  56.          END;
  57.     END;
  58.     END;
  59.  
  60. END;
  61.  
  62. {Mainline}
  63. BEGIN
  64.  
  65.   Graphics := 320;
  66.   Loop := True;
  67.   GetTandy11(Tandy11);
  68.   MediumGraphics;
  69.   While True DO
  70.     BEGIN
  71.       ClearScreen;
  72.       IF Graphics = 320 THEN
  73.     SetCursor(1, 18)
  74.       ELSE
  75.     SetCursor(1, 38);
  76.       PrintString('WORMY');
  77.       CR := 0;
  78.       XR := 0.1;
  79.       WHILE (XR <= 1.1) AND (Loop = True) DO
  80.     BEGIN
  81.       CR := CR + 0.1;
  82.       IF Graphics = 320 THEN
  83.         BEGIN
  84.           X := Round(XR * 200);
  85.           Y := Round(Sin(XR * 24) * (XR * 50) + 100);
  86.           Radius := Round(XR * 40);
  87.           C := Round(CR);
  88.           ExtCircleC(X, Y, Radius, C);
  89.         END
  90.       ELSE
  91.         BEGIN
  92.           X := Round(XR * 400);
  93.           Y := Round(Sin(XR * 24) * (XR * 50) + 100);
  94.           Radius := Round(XR * 75);
  95.           C := Round(CR);
  96.           ExtCircleC(X, Y, Radius, C);
  97.         END;
  98.         IF CR > 15 THEN
  99.           CR := 0;
  100.       XR := XR + 0.002;
  101.       CheckKey;
  102.     END;
  103.       IF XR >= 1.1 THEN
  104.     BEGIN
  105.       GetTime(H, M, S, S100);
  106.       X := S;
  107.       Y := 1;
  108.       REPEAT
  109.         GetTime(H, M, S, S100);
  110.         IF X <> S THEN
  111.           BEGIN
  112.         Inc(Y);
  113.         X := S;
  114.           END;
  115.       UNTIL (Y = 7) OR (KeyPressed);
  116.     END;
  117.       Loop := True;
  118.     END;
  119.  
  120. END.
  121.